;;########################################################################
;; regvis2.lsp
;; Visualization for OLS, Robust & Monotonic Regression ViSta model object
;; Copyright (c) 1995-6 by Carla M. Bann. Modified by FWY 1998-2000
;;
;; This file continues moral-spreadplot-supervisor-proto code
;;########################################################################

(defmeth morals-spreadplot-supervisor-proto :get-influence (plot)
  (let* (
         (pindex nil)
         (infl-list (list "MR-Lev" "MR-Cooks" "RR-Lev" "RR-Cooks" "LR-Lev" "LR-Cooks"))
         (initial-index nil)
         (choice2 nil)
         (infl-type nil)
         (i 0)
         (mod (send self :model))
         (model (send mod :morals-model))
         (morals-model (send mod :morals-model))
         (lin-reg (send mod :lin-reg-model))
         (dv2 (select (send mod :variables) (send mod :dv)))
         (dv (if (listp dv2) (select dv2 0) dv2))
         (opred (strcat "Fitted " dv))
         (mpred (strcat "Linearized Fitted " dv))
         (rpred (strcat "Robust Predicted " dv))
         (labels (send mod :labels))
         (color 'black)
        )
    #+color(when (> *color-mode* 0) (setf color 'blue))
   (if (equalp plot (send self :influence-plot1)) (setf pindex 1) (setf pindex 2))
   (if (= pindex 1) (setf infl-type (send self :infl-type1))
                    (setf infl-type (send self :infl-type2)))
   (if (equalp (send mod :method) "Robust") 
        (setf model (send mod :robust-model))
        (setf model (send mod :morals-model)))
   (dotimes (i 6)
            (if (equalp infl-type (select infl-list i))
                (setf initial-index i)))
   (when (equalp (send mod :method) "OLS") 
         (setf choice2 (choose-item-dialog "Choose an influence statistic:"
                       '("Leverages" 
                         "Cooks Distances")
                       :initial (- initial-index 4))))
   (when (equalp (send mod :method) "Monotonic")
         (if (> initial-index 3)
             (setf initial-index (- initial-index 4))
             (setf initial-index (+ initial-index 2)))
         (setf choice2 (choose-item-dialog "Choose an influence statistic:"
                  '("OLS Leverages" "OLS Cooks Distances"
                    "Monotone Leverages" 
                    "Monotone Cooks Distances")
                   :initial initial-index)))
   (when (equalp (send mod :method) "Robust")
         (if (> initial-index 3) (setf initial-index (- initial-index 4)))
         (setf choice2 (choose-item-dialog "Choose an influence statistic:"
                  '("OLS Leverages" "OLS Cooks Distances"
                    "Robust Leverages" "Robust Cooks Distances")
                   :initial initial-index))) 
  (case choice2
      (0 (send plot :clear-points)
         (send plot :add-points (send lin-reg :fit-values)
               (send lin-reg :leverages) :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list opred "OLS Leverages"))
         (send plot :adjust-to-data)
         (if (= pindex 1) 
             (send self :infl-type1 "LR-Lev") 
             (send self :infl-type2 "LR-Lev")))
      (1 (send plot :clear-points)
         (send plot :add-points (send lin-reg :fit-values)
               (send lin-reg :cooks-distances) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list opred "OLS Cook's Distances"))
         (send plot :adjust-to-data)
         (if (= pindex 1) 
             (send self :infl-type1 "LR-Cooks")
             (send self :infl-type2 "LR-Cooks")))
      (2 (send plot :clear-points)
         (send plot :add-points (send model :fit-values)
               (send model :leverages) :color color :point-labels labels)
         (cond 
           ((equalp (send mod :method) "Robust")
            (send plot :variable-label '(0 1)
                  (list rpred "Robust Leverages"))
            (if (= pindex 1) 
                (send self :infl-type1 "RR-Lev") 
                (send self :infl-type2 "RR-Lev")))
           (t
            (send plot :variable-label '(0 1) 
                  (list mpred "Monotone Leverages"))
            (if (= pindex 1) 
                (send self :infl-type1 "MR-Lev") 
                (send self :infl-type2 "MR-Lev"))))
         (send plot :adjust-to-data))
      (3 (send plot :clear-points)
         (send plot :add-points (send model :fit-values)
               (send model :cooks-distances) 
               :color color :point-labels labels)
         (cond
           ((equalp (send mod :method) "Robust")
            (send plot :variable-label '(0 1)
                  (list rpred "Robust Cook's Distances"))
            (if (= pindex 1) 
                (send self :infl-type1 "RR-Cooks") 
                (send self :infl-type2 "RR-Cooks")))
           (t
            (send plot :variable-label '(0 1) 
                  (list mpred "Monotone Cook's Distances"))
            (if (= pindex 1) 
                (send self :infl-type1 "MR-Cooks") 
                (send self :infl-type2 "MR-Cooks"))))
         (send plot :adjust-to-data)))))


 
(defmeth morals-spreadplot-supervisor-proto :get-residuals (plot &optional choice)  
  (let* (
         (resid-list (list "MR-Raw" "MR-Bayes" "MR-Student" "MR-External"  
                           "RR-Raw" "RR-Bayes" "RR-Student" "RR-External"
                           "LR-Raw" "LR-Bayes" "LR-Student" "LR-External"))
         (mod (send self :model))        
         (morals-model (send mod :morals-model))
         (model (if (equalp (send mod :method) "Robust") 
                    (send mod :robust-model) morals-model))
         (lin-reg (send mod :lin-reg-model))
         (dv2 (select (send mod :variables) (send mod :dv)))
         (dv (if (listp dv2) (select dv2 0) dv2))
         (opred (strcat "Fitted " dv))
         (mpred (strcat "Fitted " dv))
         (rpred (strcat "Fitted" dv))
         (pindex nil)
         (i 0)
         (initial-index nil)
         (resid-type nil)
        ; (choice nil)
         (r (/ (send model :residuals) (send model :sigma-hat)))
         (r2 (/ (send lin-reg :residuals) (send lin-reg :sigma-hat)))
         (d (* 2 (sqrt (send model :leverages))))
         (low (- r d))
         (high (+ r d))
         (d2 (* 2 (sqrt (send lin-reg :leverages))))
         (low2 (- r2 d2))
         (high2 (+ r2 d2))
         (x-values (send model :fit-values))
         (x-values2 (send lin-reg :fit-values))
         (labels (send mod :labels))
         (color 'black)
         (npts (send (send self :transformation-plot) :num-points))
         (point-colors (send (send self :transformation-plot) :point-color (iseq npts)))
         (point-symbols)
        )
    #+color(when (> *color-mode* 0) (setf color 'blue))
    (if (equalp plot (send self :residual-plot1)) (setf pindex 1) (setf pindex 2)) 
    (if (= pindex 1) (setf resid-type (send self :resid-type1)) 
        (setf resid-type (send self :resid-type2)))
    (dotimes (i 12)
             (if (equalp resid-type (select resid-list i))
                  (setf initial-index i)))
    (unless choice 
            (when (equalp (send mod :method) "OLS")
                  (setf choice (choose-item-dialog "Choose type of residuals: "
                         '("Residuals"
                          "Bayes Residuals"
                           "Standardized Residuals")
                         :initial (- initial-index 8)))) 
            (when (equalp (send mod :method) "Monotonic")
                  (if (< initial-index 8)
                      (setf initial-index (+ initial-index 3))
                      (setf initial-index (- initial-index 8)))
                  (setf choice (choose-item-dialog "Choose type of residuals: "
                  '("OLS Residuals" 
                    "Bayes OLS Residuals"
                    "Standardized OLS Residuals" 
                  ;  "Externally Standardized Residuals"
                    "Raw Monotone Residuals" 
                    "Bayes Monotone Residuals" 
                    "Standardized Monotone Residuals" 
                   ; "Externally Standardized Monotone Residuals" 
                         ) 
                    :initial initial-index)))
            (when (equalp (send mod :method) "Robust")
                  (if (< initial-index 8)
                      (setf initial-index (+ initial-index 3))
                      (setf initial-index (- initial-index 8)))
                  (setf choice (choose-item-dialog "Choose type of residuals: "
                  '("OLS Residuals" 
                    "Bayes OLS Residuals"
                    "Standardized OLS Residuals" 
                  ;  "Externally Standardized OLS Residuals"
                    "Weighted Robust Residuals"
                    "Bayes Robust Residuals"
                    "Standardized Robust Residuals"
                  ;  "Externally Standardized Robust Residuals"
                         ) 
                    :initial initial-index)))
            (if choice (when (> choice 2) (setf choice (+ choice 1)))))
    (case choice
      (0 (send plot :point-coordinates 0 (send lin-reg :fit-values))
         (send plot :point-coordinates 1 (send lin-reg :raw-residuals))
     #| (0 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send lin-reg :fit-values)
               (send lin-reg :raw-residuals) 
              ; :color point-colors
               :point-labels labels)
         (mapcar #'(lambda (i color)
                     (send plot :point-colors i color))
                 (iseq npt) point-colors)
           |#
         (send plot :variable-label '(0 1) (list opred "OLS Residuals"))
         (send plot :abline 0 0)
         (send plot :adjust-to-data) 
         (if (= pindex 1) (send self :resid-type1 "LR-Raw") (send self :resid-type2 "LR-Raw")))
      (1 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points x-values2 r2 
               :color point-colors 
               :point-labels labels)
         (map 'list #'(lambda (a b c d) (send plot :plotline a b c d nil))
               x-values2 low2 x-values2 high2)
         (send plot :abline 0 0)
         (send plot :variable-label '(0 1) (list opred "Bayes OLS Residuals"))
         (send plot :adjust-to-data)
         (if (= pindex 1) (send self :resid-type1 "LR-Bayes") (send self :resid-type2 "LR-Bayes")))
      (2 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send lin-reg :fit-values)
               (send lin-reg :studentized-residuals) 
               :color color :point-labels labels)
         (send plot :abline 0 0)
         (send plot :variable-label '(0 1) (list opred "Standardized OLS Residuals")) 
         (send plot :adjust-to-data)
         (if (= pindex 1) (send self :resid-type1 "LR-Student") (send self :resid-type2 "LR-Student")))
      (3 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send lin-reg :fit-values) 
               (send lin-reg :externally-studentized-residuals)
               :color color :point-labels labels)
         (send plot :abline 0 0)
         (send plot :variable-label '(0 1) (list opred "Externally Standardized OLS Residuals"))
         (send plot :adjust-to-data)
         (if (= pindex 1) (send self :resid-type1 "LR-External") (send self :resid-type2 "LR-External")))
      (4 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send model :fit-values)
               (send model :residuals) :color color :point-labels labels)
         (send plot :abline 0 0)
         (if (equalp (send mod :method) "Robust")
             (send plot :variable-label '(0 1) 
                   (list rpred "Weighted Robust Residuals"))
             (send plot :variable-label '(0 1) 
                   (list mpred "Monotone Residuals")))
         (send plot :adjust-to-data)
         (if (= pindex 1) (send self :resid-type1 "MR-Raw") (send self :resid-type2 "MR-Raw")))
      (5 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points x-values r :color color :point-labels labels)
         (send plot :abline 0 0)
         (map 'list #'(lambda (a b c d) (send plot :plotline a b c d nil))
               x-values low x-values high)
         (if (equalp (send mod :method) "Robust")
             (send plot :variable-label '(0 1)
                   (list rpred "Bayes Robust Residuals"))
             (send plot :variable-label '(0 1) 
                   (list mpred "Bayes Monotone Residuals")))
         (send plot :adjust-to-data)
         (if (= pindex 1) (send self :resid-type1 "MR-Bayes") (send self :resid-type2 "MR-Bayes")))
      (6 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send model :fit-values)
               (send model :studentized-residuals) 
               :color color :point-labels labels)
         (send plot :abline 0 0)
         (if (equalp (send mod :method) "Robust")
             (send plot :variable-label '(0 1)
                   (list rpred "Standardized Robust Residuals"))
             (send plot :variable-label '(0 1) 
                   (list mpred "Standardized Monotone Residuals")))
         (send plot :adjust-to-data)
         (if (= pindex 1) (send self :resid-type1 "MR-Student") (send self :resid-type2 "MR-Student")))
      (7 (send plot :clear-points)
         (send plot :clear-lines)
         (send plot :add-points (send model :fit-values) 
               (send model :externally-studentized-residuals)
               :color color :point-labels labels)
         (send plot :abline 0 0)
         (if (equalp (send mod :method) "Robust")
             (send plot :variable-label '(0 1)
                   (list rpred "Externally Standardized Robust Residuals"))
             (send plot :variable-label '(0 1) 
                   (list mpred "Externally Standardized Monotone Residuals")))
         (send plot :adjust-to-data)
         (if (= pindex 1) (send self :resid-type1 "MR-External") (send self :resid-type2 "MR-External")))

      )
    ))

 
(defmeth morals-spreadplot-supervisor-proto :update-residual-plot (&optional renew)
  (let* ((resid-list (list "MR-Raw" "MR-Bayes" "MR-Student" "MR-External"
                           "RR-Raw" "RR-Bayes" "RR-Student" "RR-External"  
                           "LR-Raw" "LR-Bayes" "LR-Student" "LR-External"))
         (resid-type (send self :resid-type1))
         (mod (send self :model))
         (model (send mod :morals-model))
         (model2 nil)
         (dv2 (select (send mod :variables) (send mod :dv)))
         (dv (if (listp dv2) (select dv2 0) dv2))
         (pred (strcat "Fitted " dv))
         (lin-reg (send mod :lin-reg-model))
         (i 0)
         (j 0)
         (itype (1+ (position resid-type resid-list :test #'equal)))
         (r (if (/= itype 9) 
                (/ (send model :residuals) (send model :sigma-hat))
                (/ (send lin-reg :residuals) (send lin-reg :sigma-hat))))
         (d (* 2 (sqrt (send model :leverages))))
         (low (- r d))
         (high (+ r d))
         (ymax (max high))
         (ymin (min low))
         (range (max (abs ymin) (abs ymax)))
         (x-values (if (/= itype 9)
                       (send model :fit-values)
                       (send lin-reg :fit-values)))
         (plot (send self :residual-plot2))
         (labels (send mod :labels))
         (color 'black)
         (conf-int (send self :confidence-intervals))
         (gnry (get-nice-range (- range) range 5))
         (gnrx (get-nice-range (min x-values) (max x-values) 5))
         (pt-colors)
        )
    (send plot :start-buffering)
    #+color(when (> *color-mode* 0) (setf color 'blue))
    (if (equalp (send mod :method) "Robust") 
        (setf model2 (send mod :robust-model))
        (setf model2 (send mod :morals-model)))
    (when renew
          (send plot :clear-points)
          (send plot :add-points x-values r :color color :point-labels labels)
          (setf pt-colors (send plot :point-color (iseq (send plot :num-points)))))
    (send plot :clear-lines)
    (send plot :abline 0 0)
    (when conf-int
          (map 'list #'(lambda (a b c d) 
                         (send plot :plotline a b c d nil))
               x-values low x-values high)
          )
    (when renew
          (send plot :variable-label '(0 1) 
                (list (strcat "Fitted " dv) "Standardized Residuals"))
          (send plot :range 0 (first gnrx) (second gnrx))
          (send plot :x-axis t t (third gnrx))
          (send plot :range 1 (first gnry) (second gnry))
          (send plot :y-axis t t (third gnry)))
    (send plot :redraw)
    (send plot :buffer-to-screen)
    (setf plot (send self :residual-plot2))
    (setf resid-type (send self :resid-type2))       
    ))


(defmeth morals-spreadplot-supervisor-proto :update-influence-plot ()
  (let* ((infl-list (list "MR-Lev" "MR-Cooks" "RR-Lev" "RR-Cooks" "LR-Lev" "LR-Cooks"))
         (infl-type (send self :infl-type1))
         (mod (send self :model))
         (model (send mod :morals-model))
         (model2 nil)
         (dv2 (select (send mod :variables) (send mod :dv)))
         (dv (if (listp dv2) (select dv2 0) dv2))
         (lin-reg (send mod :lin-reg-model))
         (i 0)
         (j 0)
         (initial-index nil)
         (x-values (send model :fit-values))
         (x-values2 (send lin-reg :fit-values))
         (plot (send self :influence-plot1))
         (labels (send mod :labels))
         (color 'black)
        )
    #+color(when (> *color-mode* 0) (setf color 'blue))
    (if (equalp (send mod :method) "Robust") 
        (setf model2 (send mod :robust-model))
        (setf model2 (send mod :morals-model)))
    (setf initial-index (position infl-type infl-list :test #'equal))
    (case initial-index
      (0 (send plot :clear-points)
         (send plot :add-points (send model2 :fit-values)
               (send model2 :leverages) :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list (strcat "Linearized Fitted " dv) "Monotone Leverages"))
         (send plot :adjust-to-data))
      (1 (send plot :clear-points)
         (send plot :add-points (send model2 :fit-values)
               (send model2 :cooks-distances) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list (strcat "Linearized Fitted " dv) "Monotone Cook's Distances"))
         (send plot :adjust-to-data))
      (2 (send plot :clear-points)
         (send plot :add-points (send model2 :fit-values)
               (send model2 :leverages) :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list (strcat "Robust Fitted " dv) "Robust Leverages"))
         (send plot :adjust-to-data))
      (3 (send plot :clear-points)
         (send plot :add-points (send model2 :fit-values)
               (send model2 :cooks-distances) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list (strcat "Robust Fitted " dv) "Robust Cook's Distances"))
         (send plot :adjust-to-data))
      (4 (send plot :clear-points)
         (send plot :add-points (send lin-reg :fit-values)
               (send lin-reg :leverages) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list (strcat "Fitted " dv) "OLS Leverages"))
         (send plot :adjust-to-data))
      (5 (send plot :clear-points)
         (send plot :add-points (send lin-reg :fit-values)
               (send lin-reg :cooks-distances) 
               :color color :point-labels labels)
         (send plot :variable-label '(0 1) (list (strcat "Fitted " dv) "OLS Cook's Distances"))
         (send plot :adjust-to-data)))
    (setf plot (send self :influence-plot2))
    (setf infl-type (send self :infl-type2))
    (setf j 1)))
